home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / copyRing.tcl < prev    next >
Encoding:
Text File  |  1999-04-13  |  8.1 KB  |  325 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*- (install)
  2.  # ###################################################################
  3.  # 
  4.  #  FILE: "copyRing.tcl"
  5.  #                    created: 3/11/94 {9:52:00 am} 
  6.  #                last update: 13/4/1999 {1:53:39 pm} 
  7.  #                
  8.  # Implementation of Emacs's kill ring. This is a paste ring.
  9.  # 
  10.  # Package modified by Dominique d'Humieres
  11.  # E-mail: <dominiq@physique.ens.fr>
  12.  # following ideas from Juan Falgueras
  13.  # E-mail: <juanfc@lcc.uma.es>
  14.  # 
  15.  # Various notes:
  16.  # 
  17.  # 1) To get the new 'smartCutPaste' behavior in TeX mode, the 'wordBreak'
  18.  # must be set to '([\w:-]+|\\(\\|[a-zA-Z]+)\*?|\\[^a-zA-Z*\t\r\n\s])'.
  19.  #
  20.  # 2) If you prefer the old 'smartCutPaste' behavior, uncomment the last
  21.  # commented paragraph at the end of the file. 
  22.  # If you want to remove it, delete the code between '•' and the lines:
  23.  # 
  24.  #  # To insert/remove spaces to ensure a single space between words when
  25.  #  # cutting or pasting, click this box||To cut/paste precisely what is 
  26.  #  # selected, click this box.
  27.  #  newPref flag smartCutPaste 1
  28.  #  lappend flagPrefs(Text) smartCutPaste
  29.  #  
  30.  # ###################################################################
  31.  ##
  32.  
  33. alpha::feature copyRing 0.1.7 global {
  34.     # To insert/remove spaces to ensure a single space between words when
  35.     # cutting or pasting, click this box||To cut/paste precisely what is 
  36.     # selected, click this box.
  37.     newPref flag smartCutPaste 1
  38.     lappend flagPrefs(Text) smartCutPaste
  39. } {
  40.     menu::replaceWith Edit "/X<Scut" items "/X<Scut" "/X<S<I<Ocut&Append"
  41.     menu::replaceWith Edit "/C<Scopy" items "/C<Scopy" "/C<S<I<Ocopy&Append"
  42.     menu::replaceWith Edit "/V<Spaste" items "/V<Spaste" "/V<S<I<OpastePop"
  43.     if {[info commands copyringCopy] == ""} {
  44.     set renamedRing 1
  45.     rename copy copyringCopy
  46.     rename cut copyringCut
  47.     rename paste copyringPaste
  48.     }
  49.     # to force loading of procs below
  50.     auto_load copy&Append
  51.     hook::register requireOpenWindowsHook [list Edit cut&Append] 1
  52.     hook::register requireOpenWindowsHook [list Edit copy&Append] 1
  53.     hook::register requireOpenWindowsHook [list Edit pastePop] 1
  54. } {
  55.     set renamedRing 0
  56.     rename copy ""
  57.     rename paste ""
  58.     rename cut ""
  59.     rename copyringCopy copy
  60.     rename copyringCut cut
  61.     rename copyringPaste paste
  62.     # so if we turn it on again we reload this file
  63.     rename copy&Append ""
  64.     hook::deregister requireOpenWindowsHook [list Edit cut&Append] 1
  65.     hook::deregister requireOpenWindowsHook [list Edit copy&Append] 1
  66.     hook::deregister requireOpenWindowsHook [list Edit pastePop] 1
  67. } help {
  68.     Provides an implementation of a copy/paste ring.
  69. }
  70.  
  71. set ringDepth    5
  72. set ringIn    0
  73. set ringOut    0
  74. set pasteStart    0
  75. set pasteFinish    0
  76.  
  77. proc copy&Append {} {
  78.     set old [getScrap]
  79.     putScrap "$old[getSelect]"
  80.     message "Appended"
  81. }
  82.  
  83. proc cut&Append {} {
  84.     global smartCutPaste
  85.  
  86.     set old [getScrap]
  87.     set text [getSelect]
  88.     putScrap "$old[getSelect]"
  89.     deleteText [getPos] [selEnd]
  90.  
  91. # • If you don't want 'smartCutPaste' delete text from the previous bullet
  92. #   to the next one
  93. #
  94.     if {[string trim "$text"] == "$text"} {
  95.     set gP [getPos]
  96.     if {$smartCutPaste} {
  97.         if {[isNoWord $gP]} {
  98.         if {[isWhite [pos::math $gP - 1]] && \
  99.             [isWordPrev  [pos::math $gP - 2]]} {
  100.             backSpace
  101.         } else {
  102.             if {[isWhite $gP]} {
  103.             deleteChar
  104.             }
  105.         }
  106.         }
  107.     }
  108.     }
  109. # •
  110.     message "Appended"
  111. }
  112.  
  113. proc cut {{rect 0}} {
  114.     global copyring ringDepth ringIn smartCutPaste
  115.  
  116.     if {[pos::compare [getPos] == [selEnd]]} {
  117.     if {[pos::compare [getMark] < [getPos]]} {
  118.         set text [getText [getMark] [getPos]]
  119.     } else {
  120.         set text [getText [getPos] [getMark]]
  121.     }
  122.     if {![string length $text]} return
  123.     } else {
  124.     set text [getSelect]
  125.     }
  126.  
  127.     set copyring([expr {$ringIn % $ringDepth}]) $text
  128.     incr ringIn
  129.  
  130.     copyringCut
  131.  
  132. # • If you don't want 'smartCutPaste' delete text from the previous bullet
  133. #   to the next one
  134. #
  135.     if {[string trim "$text"] == "$text"} {
  136.     set gP [getPos]
  137.     if {$smartCutPaste && !$rect} {
  138.         if {[isNoWord $gP]} {
  139.         if {[isWhite [pos::math $gP - 1]] && \
  140.             [isWordPrev  [pos::math $gP - 2]]} {
  141.             backSpace
  142.         } else {
  143.             if {[isWhite $gP]} {
  144.             deleteChar
  145.             }
  146.         }
  147.         }
  148.     }
  149.     }
  150. # •
  151. }
  152.  
  153. proc copy {} {
  154.     global copyring ringDepth ringIn
  155.     
  156.     if {[pos::compare [getPos] == [selEnd]]} {
  157.     if {[pos::compare [getMark] < [getPos]]} {
  158.         set text [getText [getMark] [getPos]]
  159.     } else {
  160.         set text [getText [getPos] [getMark]]
  161.     }
  162.     if {![string length $text]} return
  163.     } else {
  164.     set text [getSelect]
  165.     }
  166.     
  167.     set copyring([expr {$ringIn % $ringDepth}]) $text
  168.     incr ringIn
  169.     
  170.     copyringCopy
  171. }
  172.  
  173. proc paste {{rect 0}} {
  174.     global copyring ringDepth ringIn ringOut smartCutPaste pasteStart \
  175.       pasteFinish
  176.     set intel 0
  177.     set ins 0
  178.     set ringOut [expr {($ringIn - 1) % $ringDepth}]
  179.     
  180. # • If you don't want 'smartCutPaste' delete text from the previous bullet
  181. #   to the next one
  182. #
  183.     if {!$rect && $smartCutPaste} {
  184.     set scrap [getScrap]
  185.     if {[isWhite [selEnd]] && [isWordPrev [pos::math [getPos] - 1]]\
  186.       && ([string trimleft $scrap] == $scrap)} {
  187.         clear
  188.         insertText " "
  189.         set ins 1
  190.     } elseif {[isWhite [pos::math [getPos] -1]] && [isWordNext [selEnd]]\
  191.       && ([string trimright $scrap] == $scrap)} {
  192.         set intel 1
  193.     }
  194.     }
  195. # •
  196.     copyringPaste
  197.     set pasteStart [pos::math [getMark] - $ins]
  198.     if {$intel} {insertText " "}
  199.     set pasteFinish [getPos]
  200. }
  201.    
  202. proc pastePop {} {
  203.     global copyring ringDepth ringIn ringOut pasteFinish pasteStart \
  204.       pasteScrap smartCutPaste
  205.     
  206.     if {!$ringIn} { beep; return}
  207.     
  208.     set ringOut [expr {$ringOut-1}]
  209.     if {$ringOut < 0} {
  210.     set ringOut [expr {(($ringDepth > $ringIn) ? $ringIn : $ringDepth) -1}]
  211.     }
  212.     
  213.     set scrap $copyring($ringOut)
  214.     
  215. # • If you don't want 'smartCutPaste' delete text from the previous bullet
  216. #   to the next one
  217. #
  218.     if {$smartCutPaste} {
  219.     if {[isWhite $pasteFinish] && [isWordPrev [pos::math $pasteStart - 1]]\
  220.       && ([string trimleft $scrap] == $scrap)} {
  221.         set scrap " $scrap"
  222.     } elseif {[isWhite [pos::math $pasteStart -1]] \
  223.       && [isWordNext $pasteFinish]\
  224.       && ([string trimright $scrap] == $scrap)} {
  225.         set scrap "$scrap "
  226.     }
  227.     }
  228. # •
  229.     set pasteScrap $scrap
  230.     copyringReplace
  231.     set pasteStart [getMark]
  232.     set pasteFinish [getPos]
  233. }
  234.  
  235. proc copyringReplace {} {
  236.     global pasteFinish pasteStart pasteScrap
  237.     
  238.     replaceText $pasteStart $pasteFinish $pasteScrap
  239. }
  240.            
  241.            
  242. proc isWhite {p} {
  243.     if {[pos::compare $p < [minPos]]} {
  244.     set scrap [getScrap]
  245.     if {([string trimright $scrap] == $scrap)} {
  246.         return 1
  247.     } else {
  248.         return 0
  249.     }
  250.     } else {
  251.     return [expr {([lookAt $p] == " ") || ([lookAt $p] == "\t")}]
  252.     }
  253. }
  254.  
  255. proc isChar {p} {
  256.     return [expr {[string match {[a-z]} [lookAt $p]]}]
  257. }
  258.  
  259. proc isWord {p} {
  260.     global wordBreak
  261.     return [regexp "$wordBreak" [lookAt $p]]
  262. }
  263.  
  264. proc isNoWord {p} {
  265.     global wordBreakPreface
  266.     return [regexp "$wordBreakPreface" [lookAt $p]]
  267. }
  268.  
  269. proc isWordNext {p} {
  270.     global wordBreak
  271.     if {[pos::compare $p < [maxPos]]} {
  272.     if {[regexp "$wordBreak" [lookAt $p]]} {
  273.         return 1
  274.     } elseif {[pos::compare [pos::math $p + 1] < [maxPos]]} {
  275.         set txt [getText $p [pos::math $p + 2]]    
  276.         if {[regexp "^$wordBreak" $txt]} {
  277.         return 1
  278.         } elseif {[pos::compare [pos::math $p + 2] < [maxPos]]} {
  279.         set txt [getText $p [pos::math $p + 3]]    
  280.         return [regexp "^$wordBreak" $txt]
  281.         }
  282.     }
  283.     }
  284.     return 0
  285. }
  286.  
  287. proc isWordPrev {p} {
  288.     global wordBreak
  289.     global wordBreak
  290.     if {[pos::compare $p > [minPos]]} {
  291.     if {[regexp "$wordBreak" [lookAt $p]]} {
  292.         return 1
  293.     } elseif {[pos::compare [pos::math $p] > [minPos]]} {
  294.         set txt [getText [pos::math $p - 1] [pos::math $p + 1]]    
  295.         if {[regexp "^$wordBreak\$" $txt]} {
  296.         return 1
  297.         } elseif {[pos::compare [pos::math $p - 1] > [minPos]]} {
  298.         set txt [getText [pos::math $p - 2] [pos::math $p + 1]]    
  299.         return [regexp "^$wordBreak\$" $txt]
  300.         }
  301.     }
  302.     }
  303.     return 0
  304. }
  305.  
  306. #
  307. #   If you prefer the previous 'smartCutPaste' behavior uncomment the 
  308. #   following paragraphs.
  309. #
  310.  
  311. ## 
  312.  # proc isNoWord {p} {
  313.  #     return [isWhite $p]
  314.  # }
  315.  # 
  316.  # proc isWordNext {p} {
  317.  #     return [isChar $p]
  318.  # }
  319.  # 
  320.  # proc isWordPrev {p} {
  321.  #     return [isChar $p]
  322.  # }
  323.  ##
  324.  
  325.